home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / disk_425.arc / TSTGAM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-03  |  895 b   |  48 lines
  1.  
  2. program tstgam;        { -> 340 }
  3. { test the gamma function }
  4.  
  5. var    x    : real;
  6.  
  7. external procedure cls;
  8.  
  9. function gamma(x: real): real;
  10. const    pi    = 3.1415926;
  11.  
  12. var    i,j    : integer;
  13.     y,gam    : real;
  14.  
  15. begin        { gamma function }
  16.   if x>=0.0 then
  17.     begin
  18.       y:=x+2.0;
  19.       gam:=sqrt(2*pi/y)*exp(y*ln(y)+(1-1/(30*y*y))/(12*y)-y);
  20.       gamma:=gam/(x*(x+1))
  21.     end
  22.   else        { x<0 }
  23.     begin
  24.       j:=0;
  25.       y:=x;
  26.       repeat
  27.     j:=j+1;
  28.     y:=y+1.0
  29.       until y>0.0;
  30.       gam:=gamma(y);        { recursive call }
  31.       for i:=0 to j-1 do
  32.     gam:=gam/(x+i);
  33.       gamma:=gam
  34.     end    { x<0 }
  35. end;        { gamma function }
  36.  
  37. begin
  38.   cls;
  39.   writeln;
  40.   repeat
  41.     repeat
  42.       write('X: ');
  43.       read(x)
  44.     until x<>0.0;
  45.     writeln('Gamma is ',gamma(x))
  46.   until x<-22.0;
  47. end.
  48.